home *** CD-ROM | disk | FTP | other *** search
/ Resource Library: Multimedia / Resource Library: Multimedia.iso / utils / graphic / viewers / general / msdos / rcdsplay / axislbl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-15  |  9.0 KB  |  213 lines
  1. {*****************************************************************************
  2.   TITLE:    AXISLBL
  3.   VERSION:  2.6
  4.   FUNCTION: Axis labeling routine for use with a graphics window.  This
  5.             routine determines the appropriate spacing for tic-marks on the
  6.             axis and then labels them.
  7.   INPUTS:   Graphics window file, extreme points for both axes, labels for
  8.             both axes.
  9.   OUTPUTS:  Tic marks and labels for both axes.
  10.   AUTHOR:   M. Riebe (Modified by R. Carlson for Turbo Pascal)
  11.   CHANGES:  6/20/85 RJC - New misfuncs version 1.6.
  12.             6/23/85 RJC - New misfuncs version 1.7
  13.             7/1/85  MTR: Cleaned up the tic marks at the beginning and end 
  14.                          of axes.
  15.             9/24/85 RJC - New rcgraf version 1.2.
  16.             9/25/85 RJC - New misfuncs version 1.8.
  17.             10/26/85 RJC: New grafuncs version 2.2 and misfuncs version 2.0.
  18.             11/24/85 RJC: New misfuncs version 2.1.
  19.             12/10/85 MTR: Added some comments in the code and put tic marks
  20.                           on the top and right borders, moved axis labels so
  21.                           that unit multipliers didn't go offscreen.
  22.              1/05/86 RJC: New version of misfuncs (2.2).
  23.              1/17/86 RJC: New version of misfuncs (2.3).
  24.              2/04/86 RJC: Totally revised AXIS to make it more modular.
  25.                           Moved STR40 declaration to misfuncs.
  26.              6/13/86 RJC: New versions.
  27.              7/09/86 RJC: New versions.
  28.              8/26/86 RJC: New versions.
  29.              12/1/86 RJC: New versions.
  30.              5/31/90 RJC: Converted to Turbo Pascal.
  31.              2/15/91 RJC: Added CLRBOX procedure.
  32. *****************************************************************************}
  33.  
  34. UNIT axislbl;
  35.  
  36. INTERFACE
  37.  
  38. USES IOFUNCS; {VERSION 1.1}
  39.  
  40. PROCEDURE axis(LEFT,RIGHT,BOT,TOP:DOUBLE;
  41.                LEFTSC,RIGHTSC,BOTSC,TOPSC:INTEGER;
  42.                xlabel,ylabel:STR40);
  43. PROCEDURE CLRBOX(X0,Y0,X1,Y1:INTEGER; BOX:BOOLEAN);
  44.   {This procedure clears the specified box and draws a box around it if
  45.    BOX is true.}
  46.  
  47. IMPLEMENTATION
  48.  
  49. USES GRAPH,
  50.      MATH;     {VERSION 1.0}
  51.  
  52. {*********************** PROCEDURE CLRBOX ******************************}
  53. PROCEDURE CLRBOX(X0,Y0,X1,Y1:INTEGER; BOX:BOOLEAN);
  54.   {This procedure clears the specified box and draws a box around it if
  55.    BOX is true.}
  56. BEGIN
  57.   SETVIEWPORT(X0,Y0,X1,Y1,CLIPON); CLEARVIEWPORT;
  58.   SETVIEWPORT(0,0,GETMAXX,GETMAXY,CLIPON);
  59.   IF BOX THEN RECTANGLE(X0,Y0,X1,Y1);
  60. END;
  61.  
  62. {******************************************************************************
  63.  TITLE   : PROCEDURE axis(LEFT,RIGHT,BOT,TOP:DOUBLE;
  64.                           LEFTSC,RIGHTSC,BOTSC,TOPSC:INTEGER;
  65.                           xlabel,ylabel:STR40);
  66.  FUNCTION:  Labels x and y axes for a plot contained in a given graphics window,
  67.             and puts tic marks at appropriate spacings for >=5 labeled points
  68.             per axis.
  69.  AUTHOR  : MTR/RJC
  70.  INPUTS  :BOTSC, TOPSC    - bottom & top vertical plot boundaries
  71.           LEFTSC, RIGHTSC - left & right horizontal plot boundaries
  72.  NOTES   : 1. The tick labels are in engineering notation except when the power
  73.               is 3 in which case the numbers are writen out in full.
  74.            2. If a label does not fit on the screen then it is not placed on
  75.               the screen at all.
  76.  CHANGES : 12/10/85 MTR: Added comments in code and tic marks on top and right
  77.                          boundaries, moved axes labels so that multipliers fit
  78.                          on the screen.
  79.             2/04/86 RJC: Totally revised.
  80.             5/31/90 RJC: Translated to Turbo Pascal.
  81. ******************************************************************************}
  82. PROCEDURE AXIS;
  83.  
  84. CONST  MINTICKS=10;   {minimum # of ticks, large and small}
  85.  
  86. VAR
  87.   MANT                   : DOUBLE;  {engineering notation mantissa}
  88.   MINXTICKS              : INTEGER; {min # large ticks between labels}
  89.   MULT                   : LONGINT; {loop counter}
  90.   ST1, ST2               : STR80;   {general usage strings}
  91.   TICKSIZE               : INTEGER; {length of ticks}
  92.   UC                     : DOUBLE;  {tick position in user coord.}
  93.   XDEC, YDEC             : INTEGER; {# digits to right of decimal to display}
  94.   XINCR, YINCR           : DOUBLE;  {tick separation in user coordinates}
  95.   XMAX, XMIN             : DOUBLE;  {max & min of x axis}
  96.   XPOS, YPOS             : INTEGER; {operating point coordinates}
  97.   XPOWER, YPOWER         : LONGINT; {power of 10 for x and y axes}
  98.   YMAX, YMIN             : DOUBLE;  {max & min of y axis}
  99.  
  100.   PROCEDURE CREATSTRINGS(ST:STR40; POWER:LONGINT; VAR ST1,ST2:STR80);
  101.   BEGIN
  102.     ST1:=ST;
  103.     IF POWER<>0 THEN BEGIN
  104.       ST1:=CONCAT(ST1,' X10');
  105.       STR(-1*POWER:5,ST2);
  106.       WHILE ST2[1]=' ' DO DELETE(ST2,1,1);
  107.       END {IF}
  108.     ELSE ST2:='';
  109.   END; {PROCEDURE CREATSTRINGS}
  110.  
  111.   FUNCTION XCOORDSC(UC:DOUBLE):INTEGER; BEGIN
  112.     XCOORDSC:=ROUND( (UC-LEFT)/(RIGHT-LEFT) * (RIGHTSC-LEFTSC) + LEFTSC);
  113.   END; {FUNCTION}
  114.  
  115.   FUNCTION YCOORDSC(UC:DOUBLE):INTEGER; BEGIN
  116.     YCOORDSC:=ROUND( (UC-BOT)/(TOP-BOT) * (TOPSC-BOTSC) + BOTSC);
  117.   END; {FUNCTION}
  118.  
  119. BEGIN
  120.   {determine extreme values}
  121.     IF RIGHT>LEFT THEN BEGIN XMAX:=RIGHT; XMIN:=LEFT; END
  122.     ELSE BEGIN XMAX:=LEFT; XMIN:=RIGHT; END;
  123.     IF TOP>BOT THEN BEGIN YMAX:=TOP; YMIN:=BOT; END
  124.     ELSE BEGIN YMAX:=BOT; YMIN:=TOP; END;
  125.   {calculate appropriate power for both scales}
  126.     IF ABS(LEFT)>ABS(RIGHT) THEN ENGNOT(LEFT,MANT,XPOWER)
  127.     ELSE ENGNOT(RIGHT,MANT,XPOWER);
  128.     IF ABS(TOP)>ABS(BOT) THEN ENGNOT(TOP,MANT,YPOWER)
  129.     ELSE ENGNOT(BOT,MANT,YPOWER);
  130.     IF XPOWER=3 THEN XPOWER:=0; IF YPOWER=3 THEN YPOWER:=0;
  131.   {calculate tick spacing}
  132.     XINCR:=CALCINCR(ABS(LEFT-RIGHT)/(MINTICKS-1));
  133.     YINCR:=CALCINCR(ABS(TOP-BOT)/(MINTICKS-1));
  134.   {calculate # of decimals to be output}
  135.     XDEC:=NUMDEC(2*XINCR/PWROF10(XPOWER));
  136.     YDEC:=NUMDEC(2*YINCR/PWROF10(YPOWER));
  137.   {put overall x label on screen if possible}
  138.     CREATSTRINGS(XLABEL,XPOWER,ST1,ST2);
  139.     SETTEXTJUSTIFY(LEFTTEXT,BOTTOMTEXT);
  140.     SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);  {horizontal text}
  141.     XPOS:=((LEFTSC+RIGHTSC) DIV 2) - ROUND((LENGTH(ST1)+LENGTH(ST2))*4);
  142.     YPOS:=BOTSC+32;    {4 lines below x axis}
  143.     IF (XPOS>=0) AND (YPOS<=GETMAXY) AND
  144.       (XPOS+(LENGTH(ST1)+LENGTH(ST2))*9<=GETMAXX) THEN BEGIN
  145.       MOVETO(XPOS,YPOS); OUTTEXT(ST1);
  146.       XPOS:=GETX; YPOS:=GETY;
  147.       OUTTEXTXY(XPOS,YPOS-8,ST2); {exponent}
  148.       END; {IF}
  149.   {put overall y label on screen if possible}
  150.     CREATSTRINGS(YLABEL,YPOWER,ST1,ST2);
  151.     SETTEXTJUSTIFY(LEFTTEXT,BOTTOMTEXT);
  152.     SETTEXTSTYLE(DEFAULTFONT,VERTDIR,1); {vertical text}
  153.     YPOS:=(BOTSC+TOPSC) DIV 2 + ROUND((LENGTH(ST1)+LENGTH(ST2))*4);
  154.     XPOS:=LEFTSC-(YDEC+8)*8-8;
  155.     IF XPOS<8 THEN XPOS:=8;
  156.     IF (ST2<>'') AND (XPOS<16) THEN XPOS:=16;
  157.     IF (YPOS<=BOTSC) AND (YPOS-(LENGTH(ST1)+LENGTH(ST2))*8>=TOPSC) THEN BEGIN
  158.       MOVETO(XPOS,YPOS); OUTTEXT(ST1);
  159.       XPOS:=GETX-8; YPOS:=GETY-LENGTH(ST1)*8;
  160.       OUTTEXTXY(XPOS,YPOS,ST2);
  161.       END; {IF}
  162.   {calculate minimum # of large ticks between x axis labeled ticks}
  163.     MINXTICKS:=1;
  164.     IF ABS(XMAX)>ABS(XMIN) THEN STR(XMAX/PWROF10(XPOWER):XDEC+8:XDEC,ST1)
  165.     ELSE STR(XMIN/PWROF10(XPOWER):XDEC+8:XDEC,ST1);
  166.     WHILE ST1[1]=' ' DO DELETE(ST1,1,1);
  167.     WHILE ((LENGTH(ST1)+2)*9) >
  168.           (2*XINCR*ABS((RIGHTSC-LEFTSC)/(RIGHT-LEFT))*MINXTICKS)
  169.       DO MINXTICKS:=MINXTICKS+1;
  170.   {add x axis ticks and labels}
  171.     FOR MULT:=ROUND((XMIN-XINCR)/XINCR) TO ROUND((XMAX+XINCR)/XINCR) DO BEGIN
  172.       UC:=MULT*XINCR;
  173.       SETTEXTJUSTIFY(CENTERTEXT,TOPTEXT);
  174.       SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  175.       IF (UC<=XMAX) AND (UC>=XMIN) THEN BEGIN
  176.         IF MULT MOD 2 = 0 THEN BEGIN {large tick}
  177.           TICKSIZE:=6;
  178.           IF (MULT DIV 2) MOD MINXTICKS = 0 THEN BEGIN {label the tick}
  179.             STR(UC/PWROF10(XPOWER):XDEC+8:XDEC,ST1);
  180.             WHILE ST1[1]=' ' DO DELETE(ST1,1,1);
  181.             XPOS:=XCOORDSC(UC); YPOS:=BOTSC+4;
  182.             IF (XPOS+LENGTH(ST1)*4)<GETMAXX THEN OUTTEXTXY(XPOS,YPOS,ST1);
  183.             END; {IF}
  184.           END {IF}
  185.         ELSE TICKSIZE:=3; {small tick}
  186.         XPOS:=XCOORDSC(UC);
  187.         LINE(XPOS,BOTSC,XPOS,BOTSC-TICKSIZE);
  188.         LINE(XPOS,TOPSC,XPOS,TOPSC+TICKSIZE);
  189.         END; {IF}
  190.       END; {FOR}
  191.   {add y axis ticks and labels}
  192.     FOR MULT:=ROUND((YMIN-YINCR)/YINCR) TO ROUND((YMAX+YINCR)/YINCR) DO BEGIN
  193.       UC:=MULT*YINCR;
  194.       SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  195.       SETTEXTJUSTIFY(RIGHTTEXT,CENTERTEXT);
  196.       IF (UC<=YMAX) AND (UC>=YMIN) THEN BEGIN
  197.         IF MULT MOD 2 = 0 THEN BEGIN {large tick}
  198.           TICKSIZE:=6;
  199.           STR(UC/PWROF10(YPOWER):YDEC+8:YDEC,ST1);
  200.           WHILE ST1[1]=' ' DO DELETE(ST1,1,1);
  201.           XPOS:=LEFTSC-8;   YPOS:=YCOORDSC(UC);
  202.           OUTTEXTXY(XPOS,YPOS,ST1);
  203.           END {IF}
  204.         ELSE TICKSIZE:=3; {small tick}
  205.         YPOS:=YCOORDSC(UC);
  206.         LINE(LEFTSC,YPOS,LEFTSC+TICKSIZE,YPOS);
  207.         LINE(RIGHTSC,YPOS,RIGHTSC-TICKSIZE,YPOS);
  208.         END; {IF}
  209.       END; {FOR}
  210. END; {PROCEDURE AXIS}
  211.  
  212. END.
  213.